home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-04 / bipl.zip / PROGS.ZIP / FARB2.ICN < prev    next >
Text File  |  1992-09-28  |  2KB  |  56 lines
  1. ############################################################################
  2. #
  3. #    File:     farb2.icn
  4. #
  5. #    Subject:  Program to generate Farberisms
  6. #
  7. #    Author:   Alan Beale
  8. #
  9. #    Date:     April 1, 1990
  10. #
  11. ###########################################################################
  12. #
  13. #     Dave Farber, co-author of the original SNOBOL programming
  14. #  language, is noted for his creative use of the English language.
  15. #  Hence the terms ``farberisms'' and ``to farberate''.  This pro-
  16. #  gram produces a randomly selected farberism.
  17. #
  18. #  Notes: Not all of the farberisms contained in this program were
  19. #  uttered by the master himself; others have learned to emulate
  20. #  him.  A few of the farberisms may be objectionable to some per-
  21. #  sons.  ``I wouldn't marry her with a twenty-foot pole.''
  22. #
  23. ############################################################################
  24. #
  25. #     This program obtains its farberisms from the farber.sen file to
  26. #  allow additional farberisms to be added without recompilation or
  27. #  straining the limits of the Icon translator.  It builds an index file
  28. #  farber.idx to allow for efficient access to the sentences file.  The
  29. #  use of untranslated I/O for the index file is necessary for correct
  30. #  behavior on some systems (e.g., MVS).
  31. #
  32. ############################################################################
  33.  
  34. procedure main(argv)
  35.    local f, ix, n
  36.  
  37.    f := open("farber.sen", "r") | stop("*** cannot open \"farber.sen\"")
  38.    if not (ix := open("farber.idx", "ru")) then {
  39.       ix := open("farber.idx", "bcu")
  40.       n := 0;
  41.       repeat {
  42.          writes(ix, left(where(f), 10))
  43.          if not read(f) then break
  44.          n +:= 1
  45.       }
  46.       seek(ix, -10)
  47.       writes(ix, left(n, 10))
  48.    }
  49.    seek(ix, -10)
  50.    &random  :=  map(&clock, ":", "8") +
  51.               map(reverse(&date[3:0]), "/", "5")
  52.    seek(ix,10*(?numeric(reads(ix,10))-1))
  53.    seek(f,numeric(reads(ix,10)))
  54.    write(read(f))
  55. end
  56.